Aminet 46/Aminet 46 (2001)(GTI - Schatztruhe)[!][Dec 2001].iso/Aminet/text/edit/edt10src.lha/txt/Files.mod

Text File | 1995-04-08 | 6KB | 277 lines

(*
  .name       Files
  .task       file management
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     Joachim Barheine
  .address    Hochgrevestraße 3, D-38640 Goslar
  .copyright  (c) 1994 by Joachim Barheine
*)

(* .info: 13/08/94, 14:28:53, version 19 *)

MODULE Files;

IMPORT
  SYS:= SYSTEM,

  ASCII,
  Dos,
  Exec,
  K:= Kernel,
  S:= Strings,
  Sett:= Settings,
  Str:= StrPool;

CONST
  nameLen* = 31;
  pathLen* = 256;
  filenameLen* = pathLen + nameLen;

TYPE
  File* = RECORD
    lock: Dos.FileLockPtr;
    fh: Dos.FileHandlePtr;
    prot: LONGSET;
    write- : BOOLEAN;       (* read/write *)
    len-, err- : LONGINT;   (* current length of file, Dos error-code *)
    pos- : LONGINT;         (* current position *)
    done- : BOOLEAN;        (* status *)
  END;

VAR
  cnt: INTEGER;

(* create a filename (for unnamed texts) *)
PROCEDURE CreateName* (VAR name: ARRAY OF CHAR);

VAR
  a: ARRAY 1 OF LONGINT;

BEGIN
  a[0]:= cnt; INC(cnt);
  K.FormatString(name, Str.unnamedN^, a);
END CreateName;

(* path from filename *)
PROCEDURE GetPath* (VAR path: ARRAY OF CHAR; filename: ARRAY OF CHAR);

VAR
  i, last: INTEGER;

(* $CopyArrays- *)

BEGIN
  last:= -1; i:= 0;
  WHILE filename[i] # ASCII.nul DO
    IF filename[i] = ":" THEN last:= i ELSIF filename[i] = "/" THEN last:= i - 1 END;
    path[i]:= filename[i];
    INC(i);
  END;
  path[i]:= ASCII.nul;
  path[last + 1]:= ASCII.nul;
END GetPath;

(* name from filename *)
PROCEDURE GetName* (VAR name: ARRAY OF CHAR; filename: ARRAY OF CHAR);

VAR
  str: Exec.LSTRPTR;

(* $CopyArrays- *)

BEGIN
  str:= Dos.FilePart(filename);
  IF str # NIL THEN COPY(str^, name) ELSE name:= "$Ohne_Namen.txt" END;
END GetName;

PROCEDURE GetFilename* (VAR filename: ARRAY OF CHAR; path, name: ARRAY OF CHAR);

(* $CopyArrays- *)

BEGIN
  COPY(path, filename);
  IF ~Dos.AddPart(filename, name, LEN(filename)) THEN filename:= "$Ohne_Namen" END;
END GetFilename;

PROCEDURE Exists* (filename: ARRAY OF CHAR): BOOLEAN;

VAR
  lock: Dos.FileLockPtr;

(* $CopyArrays- *)

BEGIN
  lock:= Dos.Lock(filename, Dos.sharedLock);
  IF lock # NIL THEN
    Dos.UnLock(lock);
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;
END Exists;

(* File methods: *)
PROCEDURE (VAR f: File) Open* (filename: ARRAY OF CHAR; write: BOOLEAN): BOOLEAN;

VAR
  fib: Dos.FileInfoBlockPtr;
  new: BOOLEAN;

  PROCEDURE Backup(file: ARRAY OF CHAR): BOOLEAN;

  VAR
    i: INTEGER;
    backup: ARRAY 300 OF CHAR;

  (* $CopyArrays- *)

  BEGIN
    COPY(file, backup);
    i:= SHORT(S.Length(file));
    IF (i >= 3) & (file[i-2] = "$") THEN
      IF (file[i-1] >= "0") & (file[i-1] < "9") THEN
        IF ORD(file[i-1]) - ORD("0") + 1 >= Sett.backups THEN
          RETURN Dos.DeleteFile(file);
        ELSE
          backup[i-1]:= CHR(ORD(file[i-1]) + 1);
        END;
      ELSE
        RETURN TRUE;  (* temporary file: auto-save, ... *)
      END;
    ELSE
      S.Append(backup, "$0");
    END;
    RETURN (~Exists(backup) OR Backup(backup)) & Dos.Rename(file, backup);
  END Backup;

(* $CopyArrays- *)

BEGIN
  f.pos:= 0;
  f.write:= write;
  new:= ~Exists(filename);
  IF write THEN
    f.prot:= LONGSET{Dos.execute};
    f.len:= 0;
    IF ~new THEN
      f.lock:= Dos.Lock(filename, Dos.sharedLock);
      IF f.lock # NIL THEN
        NEW(fib);
        IF Dos.Examine(f.lock, fib^) THEN f.prot:= fib.protection END;
        DISPOSE(fib);
        Dos.UnLock(f.lock); f.lock:= NIL;
      END;
    END;
    IF ~new & (Sett.backups # Sett.backupsOff) & ~Backup(filename) THEN RETURN FALSE END;
    f.fh:= Dos.Open(filename, Dos.newFile);
    f.done:= f.fh # NIL;
  ELSE
    f.lock:= Dos.Lock(filename, Dos.sharedLock);
    f.done:= f.lock # NIL;
    IF f.done THEN
      NEW(fib);
      f.done:= Dos.Examine(f.lock, fib^);
      IF f.done THEN
        f.len:= fib.size;
        f.prot:= fib.protection;
        f.fh:= Dos.OpenFromLock(f.lock);
        f.done:= f.fh # NIL;
        IF ~f.done THEN Dos.UnLock(f.lock) END;
      ELSE
        Dos.UnLock(f.lock);
      END;
      DISPOSE(fib);
    END;
  END;
  IF ~f.done THEN f.err:= Dos.IoErr() END;
  RETURN f.done;
END Open;

PROCEDURE (VAR f: File) Close*;

VAR
  name: UNTRACED POINTER TO ARRAY 256 OF CHAR;

  PROCEDURE Close;

  VAR
    i: INTEGER;

  BEGIN
    FOR i:= 0 TO 4 DO  (* timeout 5 secs. *)
      IF Dos.Close(f.fh) THEN RETURN END;
      Dos.Delay(50);
    END;
  END Close;

BEGIN
  f.done:= TRUE;
  IF f.write THEN
    NEW(name);
    IF Dos.NameFromFH(f.fh, name^, LEN(name^)) THEN
      Close;
      IF Dos.SetProtection(name^, f.prot + LONGSET{Dos.execute}) THEN END;
    ELSE
      Close;
    END;
    DISPOSE(name);
    RETURN;
  END;
  Close;
  IF ~f.write THEN Dos.UnLock(f.lock) END;
END Close;

PROCEDURE (VAR f: File) Read* (VAR str: ARRAY OF SYS.BYTE; len: LONGINT);

VAR
  l: LONGINT;

BEGIN
  IF f.done THEN
    l:= Dos.Read(f.fh, str, len);
    INC(f.pos, l);
    f.done:= l = len;
    IF ~f.done THEN f.err:= Dos.IoErr() END;
  END;
END Read;

PROCEDURE (VAR f: File) Write* (str: ARRAY OF SYS.BYTE; len: LONGINT);

VAR
  l: LONGINT;

(* $CopyArrays- *)

BEGIN
  IF f.done THEN
    l:= Dos.Write(f.fh, str, len);
    INC(f.len, l); INC(f.pos, l);
    f.done:= l = len;
    IF ~f.done THEN f.err:= Dos.IoErr() END;
  END;
END Write;

PROCEDURE (VAR f: File) WriteFrom* (str: ARRAY OF SYS.BYTE; from, len: LONGINT);

VAR
  l: LONGINT;
  tricky: Exec.LSTRPTR;

(* $CopyArrays- *)

BEGIN
  IF f.done THEN
    tricky:= SYS.VAL(Exec.LSTRPTR, SYS.VAL(LONGINT, SYS.ADR(str)) + from);
    l:= Dos.Write(f.fh, tricky^, len);
    INC(f.len, l); INC(f.pos, l);
    f.done:= l = len;
    IF ~f.done THEN f.err:= Dos.IoErr() END;
  END;
END WriteFrom;

BEGIN
  cnt:= 0;
END Files.